Já olhamos os decks de Gwent para identificar e explorar as regras de associação entre as cartas, o que alavanca as estratégias de utilização das mesmas conhecidas pela comunidade. Neste post vamos tomar outra abordagem e buscar os pares de cartas cujas características são mais similares entre si e que, portanto, poderia fornecer algum outro tipo de estratégia ainda não explorada e/ou facilitar a nossa vida quanto à escolha das cartas que colocaremos em um deck
Há algum tempo atrás construí um scrapper para raspar a biblioteca de decks de Gwent, de forma à usar esses dados para me ajudar à tomar melhores decisões na hora de montar meus próprios decks. Uma das primeiras análises que fiz com aqueles dados foi tentar entender os padrões de co-ocorrência das cartas de Gwent entre os decks contribuídos pela comunidade, utilizando para isso uma análise orientada à regras de associação. Este primeiro exercício acabou sendo bastante positivo, pois consegui extrair alguns insights bastante relevantes, que acabaram melhorando a minha estratégia e experiência de jogo.
Um ponto importante daquela primeira análise é que ela olhou para os padrões de co-ocorrência de cartas conhecidos e explorados pela comunidade, deixando de fora àquelas combinações de cartas que teriam o potencial de funcionar juntas, mas que nunca foram testadas. Estas combinações normalmente implementam mecânicas específicas de jogo, que podem ser identificadas através da descrição dos efeitos associados à cada carta. Assim, se pudéssemos agrupar as cartas de acordo com os padrões de texto existente em suas descrições, então poderíamos identificar as cartas que implementam mecânicas similares e, portanto, poderiam ser usadas juntas.
Uma forma de implementar este tipo de agrupamento é através da modelagem de tópicos, uma técnica de aprendizado não-supervisionado que faz uso de modelos estatísticos para encontrar temas abstratos de acordo com as palavras compõem os textos em uma coleção dos mesmos. Existem alguns modelos que podem ser implementados para esta finalidade, sendo o mais conhecido deles a LDA - Latent Dirichlet Allocation; todavia, vou utilizar este post para estudar, explorar e demonstrar as funcionalidades de um outro modelo de tópicos: o STM, Structural Topic Model (Roberts, Stewart, and Tingley (2019)). Meu objetivo com isso será utilizar este modelo para criar uma representação do quão similares as cartas são de acordo com seus padrões de texto e utilizar esta representação para encontrar as cartas mais similares àquela que eu resolver buscar.
Antes de chegar aos objetivos finais desta análise vamos cobrir alguns pontos importantes. Iniciaremos falando um pouco sobre a aquisição dos dados e, então, passaremos para uma breve análise exploratória. Começaremos a modelagem de tópicos falando um pouquinho mais da intuição por trás do STM e, então, vamos implementar tanto uma busca pela quantidade de tópicos que devemos utilizar antes de ajustar o modelo em si. A partir daí conduziremos algumas análises relacionadas ao pós-processamento e entedimento dos tópicos, bem como a validação do modelo. Fecharemos então o post mostrando a aplicação do modelo para atingir os objetivos principais que definimos.
Os dados que vamos utilizar neste post podem ser obtidos utilizando o scrapper apresentado neste post. O resultado daquele processamento retorna um tibble com a composição de cartas em cada um dos decks rasparados, bem como os metadados associados à cada uma das cartas. Assim, podemos reduzir àquela base à uma que fale apenas das cartas se usarmos um distict focando apenas no nome das cartas e em seus metadados. Você pode encontrar esta etapa do pós-processamento no código que acompanha este post.
Assumindo que já temos a base de dados com os metadados de cada carta, vamos carregar alguns pacotes que usaremos neste post e, na sequência, carregar a base de dados. Precisaremos fazer dois pequenos ajustes, para resolver duas inconsistências que existem neles:
Solução engenhosa possui dois nomes em inglês - Blueprint e Engineering solution -, o que faz com que esta carta esteja duplicada na nossa base de dados. Assim, precisaremos remover uma ocorrência dela (selecionei remover a Blueprint, mas não faz diferença); e,Vidente, mas uma pentercente à facção Scoia'tael e a outra é uma carta Neutra. Assim, para evitar confusões, vamos adicionar o nome da facção ao nome da carta.# carregando os pacotes
library(tidyverse) # core
library(tidytext) # para manipular texto
library(patchwork) # para compor figuras
library(stringi) # para trabalhar com texto
library(reactable) # para tabelas interativas
library(reactablefmtr) # para ajudar com o reactable
# carregando os dados
cartas <- read_rds(file = 'data/cartas.rds')
# cartas <- read_rds(file = '_posts/2022-01-31-card-embeddings-parte-1/data/cartas.rds')
# ajustando a tabela por conta de duas cartas má registradas
cartas <- cartas %>%
# removendo a carta Solução Engenhosa, que aparece duas vezes por conta de diferencas
# em seu nome em ingles
filter(!(localizedName == 'Solução engenhosa' & name != 'Blueprint')) %>%
# ajustando o nome da carta Vidente, que aparece duas vezes pois existe uma na facção
# neutra e outra na Scoia'tael, mas sao cartas diferentes
mutate(
localizedName = case_when(localizedName == 'Vidente' ~ paste0(localizedName, ' (', slug, ')'),
TRUE ~ localizedName)
) %>%
# colocando as cartas em ordem alfabetica
arrange(localizedName)
cartas
# A tibble: 1,103 × 19
localizedName name short slug rarity cardGroup type categoryName
<chr> <chr> <chr> <chr> <chr> <chr> <chr> <chr>
1 A Fera The … mon Mons… Épica gold Unid… Espectro
2 A prática le… Prac… nor Nort… Rara bronze Espe… Feitiço
3 A Terra das … Land… neu Neut… Lendá… gold Arte… Local
4 A Trufa Carn… The … neu Neut… Lendá… gold Arte… Local
5 Abaya Abaya mon Mons… Épica gold Unid… Necrófago
6 Aberrações d… Whor… syn Synd… Épica gold Unid… Humano, Bil…
7 Abominação S… Sala… syn Synd… Rara bronze Unid… Fera, Mutan…
8 Acônito Wolf… neu Neut… Lendá… gold Espe… Nenhuma
9 Açougueiro d… Sval… ske Skel… Comum bronze Unid… Humano, Cul…
10 Adaga Cerimo… Cere… neu Neut… Lendá… gold Estr… Estratégia
# … with 1,093 more rows, and 11 more variables: ownable <lgl>,
# decks <int>, craftingCost <int>, power <int>,
# provisionsCost <int>, armour <int>, keywords <chr>, texto <chr>,
# fluff <chr>, small <chr>, big <chr>
Se tudo estiver correto, devemos ter 1.103 cartas em nossa base de dados. Além disso, devemos ter muito mais cartas Neutras do que cartas de facção dentro da nossa base, um pouquinho mais de cartas da facção Syndicate do que das demais facções, e um número similar de cartas entre todas as outras cinco facções - conforme apresentado na figura abaixo. Estes padrões de variação na quantidade de cartas parecem estar associados à natureza daquelas duas primeiras: cartas neutras podem ser utilizadas com os decks de qualquer facção, assim como algumas cartas específicas da facção Syndicate.
cartas %>%
# contando quantidade de cartas existentes por faccao
count(slug, name = 'n_cartas') %>%
# ordenando as colunas
mutate(slug = fct_reorder(.f = slug, .x = n_cartas)) %>%
# criando a figura
ggplot(mapping = aes(x = n_cartas, y = slug, fill = slug)) +
geom_col(color = 'black', size = 0.3, show.legend = FALSE) +
geom_text(mapping = aes(label = n_cartas), nudge_x = 10, fontface = 'bold') +
scale_fill_manual(values = cores_por_faccao) +
labs(
title = 'Quantas cartas diferentes existem por facção?',
x = 'Quantidade de cartas'
) +
theme(axis.title.y = element_blank())
Com tudo carregado, podemos começar a análise exploratória dos dados das cartas. Nosso principal foco será entender de onde vem as principais diferenças entre as cartas dentro e entre as facções, e como isto está relacionado às estratégias e mecânicas de jogo.
Vamos começar olhando as nossas análises focando nos textos de descrição associados à cada carta. Para isso, vamos quebrar os textos em tokens utilizando a função unnest_tokens, remover os nomes de algumas das facções que estejam entre os resultados (bem como as cartas que simplesmente não tem nenhum texto associado) e, finalmente, contar quantas vezes cada palavra ocorre em cada carta. Uma vez que tenhamos essa estrutura de dados, vamos usar a função bind_tf_idf para calcular o tf-idf (term frequency-inverse document frequency) associado à cada palavra entre as cartas dentro de cada facção. Esta métrica representa o equilíbrio entre a frequência de ocorrência de uma palavra entre todas as cartas de uma dada facção e a frequência com a qual àquela mesma palavra ocorre entre todas as cartas: quanto mais exclusiva à uma facção for uma palavra, maior será o valor desta métrica. Desta forma, esta métrica nos ajuda à identificar mais facilmente as palavras mais representativas das cartas de cada facção.
Os resultados desta análise preliminar são apresentados na figura abaixo, que confirma a expectativa de que existem diferenças nas palavras associadas aos textos de descrição de cada carta. Ao que podemos observar, estes textos são muito informativos de alguns temas que parecem ser inerentes à cada facção e outros temas que parecem ser comuns entre elas.
cartas %>%
# quebrando o string em tokens
unnest_tokens(output = token, input = texto, to_lower = TRUE) %>%
# removendo os NAs e algumas palavras que não ajudam a visualização
filter(!is.na(token),
str_detect(string = token, pattern = "scoia'tael|reinos|skellige|norte|dos", negate = TRUE)) %>%
# contando as categorias por faccao
count(slug, token, name = 'ocorrencias') %>%
# calculando o tf-idf
bind_tf_idf(term = token, document = slug, n = ocorrencias) %>%
# agrupando pela faccao
group_by(slug) %>%
# pegando os 15 tokens com maior tf-idf
slice_max(order_by = tf_idf, n = 15, with_ties = FALSE) %>%
# desagrupando
ungroup %>%
# ordenando as colunas
mutate(token = reorder_within(x = token, by = tf_idf, within = slug)) %>%
# criando a figura
ggplot(mapping = aes(x = tf_idf, y = token, fill = slug)) +
facet_wrap(~ slug, scales = 'free') +
geom_col(color = 'black', size = 0.3, show.legend = FALSE) +
scale_y_reordered() +
scale_x_continuous(labels = scales::label_number(accuracy = 0.001)) +
scale_fill_manual(values = cores_por_faccao) +
labs(
title = 'Quais as palavras mais representativas das cartas de cada facção?',
subtitle = 'As palavras associadas à cada facção remetem às mecânicas, estratégias e personagens associados à cada uma delas',
x = 'TF-IDF'
) +
theme(axis.title.y = element_blank())
Um dos temas comuns que pudemos observar na figura acima é a citação à diversos tipos de personagens comuns em gêneros de RPG. O exemplo mais claro disso é aquele observado na facção Scoia'tael, onde vimos que palavras como elfo, anão e dríade são bastante característicos. Para validar essa observação, calculei o tf-idf focando na informação dos tipos de personagem associados à cada carta, de forma à identificar mais claramente os personagens característicos de cada facção. Em linha com o que esperávamos, os personagens associados à cada facção retratam a natureza de cada uma delas: observamos diversos monstros e nenhum bruxo na facção Monsters, muitas criaturas da floresta, elfos e anões na facção Scoia'tael e diversos personagens associados à guerras e batalhas nas facções Nilfgaard e Northern Realms. Conhecer essas associações são importantes pois algumas mecânicas de jogo dependem do tipo de personagem associado à cada carta (e.g., ‘invoca uma carta da Caçada Selvagem’) e, ainda, existem modos de jogo que favorecem alguns tipos de personagens específicos (e.g., bruxos não são penalizados).
cartas %>%
# pegando apenas as cartas de unidade
filter(type == 'Unidade') %>%
# quebrando o string em tokens
unnest_tokens(output = token, input = categoryName, to_lower = FALSE,
token = 'regex', pattern = ', ') %>%
# contando as categorias por faccao
count(slug, token, name = 'ocorrencias') %>%
# calculando o tf-idf
bind_tf_idf(term = token, document = slug, n = ocorrencias) %>%
# agrupando pela faccao
group_by(slug) %>%
# pegando os 15 tokens com maior tf-idf
slice_max(order_by = tf_idf, n = 10, with_ties = FALSE) %>%
# desagrupando
ungroup %>%
# ordenando as colunas
mutate(token = reorder_within(x = token, by = tf_idf, within = slug)) %>%
# criando a figura
ggplot(mapping = aes(x = tf_idf, y = token, fill = slug)) +
facet_wrap(~ slug, scales = 'free') +
geom_col(color = 'black', size = 0.3, show.legend = FALSE) +
scale_y_reordered() +
scale_x_continuous(breaks = seq(from = 0, to = 0.3, by = 0.05)) +
scale_fill_manual(values = cores_por_faccao) +
labs(
title = 'Quais os tipos de personagem associados às cartas de cada facção?',
subtitle = 'Os personagens associados à cada facção retratam a natureza de cada uma delas',
x = 'TF-IDF'
) +
theme(axis.title.y = element_blank())
Além do texto de descrição das cartas tocar no tema dos tipos de personagem, ela também toca nos tipos de habilidade que cada carta implementa. Na realidade, existem 75 habilidades diferentes que podem estar associadas às cartas, sendo que cada carta pode ter um número qualquer de habilidades - de nenhuma à várias. As habilidades associadas à cada carta são apresentadas na coluna keywords, e são separadas umas das outras através de um ponto-e-vírgula. Para construir o mesmo tipo de intuição sobre as habilidades mais representativas das cartas de cada facção, utilizei novamente o tf-idf. O resultado dessa análise é apresentada através da figura abaixo, onde podemos ver que:
consumir (consume) da facção Monsters, lucrar (profit) e moedas (coin) da facção Syndycate e assimilar (assimilate) da facção Nilfgaard;desejo de morte (deathwish; Monsters, Northern Realms e Skellige) e envenenamento (poison; Neutral, Nilfgaard, Scoia'tael e Syndicate); e,iniciativa (initiative) e cataclisma (cataclysm).cartas %>%
# quebrando o string em tokens
unnest_tokens(output = token, input = keywords, to_lower = FALSE,
token = 'regex', pattern = ';') %>%
# removendo os NAs
filter(!is.na(token)) %>%
# contando as categorias por faccao
count(slug, token, name = 'ocorrencias') %>%
# calculando o tf-idf
bind_tf_idf(term = token, document = slug, n = ocorrencias) %>%
# agrupando pela faccao
group_by(slug) %>%
# pegando os 10 tokens com maior tf-idf
slice_max(order_by = tf_idf, n = 10, with_ties = FALSE) %>%
# desagrupando
ungroup %>%
# ordenando as colunas
mutate(token = reorder_within(x = token, by = tf_idf, within = slug)) %>%
# criando a figura
ggplot(mapping = aes(x = tf_idf, y = token, fill = slug)) +
facet_wrap(~ slug, scales = 'free') +
geom_col(color = 'black', size = 0.3, show.legend = FALSE) +
scale_y_reordered() +
scale_fill_manual(values = cores_por_faccao) +
labs(
title = 'Quais as habilidades mais representativas das cartas de cada facção?',
subtitle = 'Algumas habilidades parecem ser específicas de certas facções, outras são compartilhadas entre poucas',
x = 'TF-IDF'
) +
theme(axis.title.y = element_blank())
Se a informação dos tipos de habilidades que uma carta têm está relacionada à descrição da carta, então não bastaria utilizarmos àquela primeira informação para achar as cartas mais similares entre si? Embora essa lógica não esteja errada, ela perde de vista um segundo aspecto importante que podemos encontrar nos textos de descrição de cada carta: a forma como as suas habilidades são implementadas. Vamos tomar como exemplo a habilidade sangramento (i.e., bleeding), que está presente entre as cartas de todas as facções: a carta que possui esta habilidade pode adicionar um status à uma carta inimiga, fazendo com que ela perca um ponto de poder por turno de jogo até um limite n de turnos (que depende da carta). Apesar da ideia por trás desta habilidade ser simples, podemos ver através da figura abaixo que as cartas à implementam de forma bem diferente entre e dentro das facções: e.g. pagando algum tipo de custo, assim que são postas no tabuleiro, quando estão com seu poder aumentado ou quando tem o seu poder aumentado e etc. Assim, é interessante então que agrupemos as cartas não só pelas habilidades que elas compartilham, mas também pela forma como as implementam.
cartas %>%
# filtrando cartas com uma habilidade especifica
filter(str_detect(string = keywords, pattern = 'bleeding')) %>%
# quebrando o string em tokens
unnest_tokens(output = token, input = texto, to_lower = TRUE) %>%
# removendo os NAs e numeros
filter(
!is.na(token),
str_detect(string = token, pattern = '[0-9]', negate = TRUE),
!token %in% c('a', 'à', 'ao', 'com', 'de', 'e', 'na', 'no', 'o', 'um')
) %>%
# contando as categorias por faccao
count(slug, token, name = 'ocorrencias') %>%
# calculando o tf-idf
bind_tf_idf(term = token, document = slug, n = ocorrencias) %>%
# agrupando pela faccao
group_by(slug) %>%
# pegando os 10 tokens com maior tf-idf
slice_max(order_by = tf_idf, n = 10, with_ties = FALSE) %>%
# desagrupando
ungroup %>%
# ordenando as colunas
mutate(token = reorder_within(x = token, by = tf_idf, within = slug)) %>%
# criando a figura
ggplot(mapping = aes(x = tf_idf, y = token, fill = slug)) +
facet_wrap(~ slug, scales = 'free') +
geom_col(color = 'black', size = 0.3, show.legend = FALSE) +
scale_y_reordered() +
scale_fill_manual(values = cores_por_faccao) +
labs(
title = 'Como a habilidade sangramento é implementada entre facções?',
subtitle = 'Uma mesma habilidade pode ser implementada de diferentes formas entre e dentro das facções',
x = 'TF-IDF'
) +
theme(axis.title.y = element_blank())
Acredito que já conseguimos ter um bom entendimento da relação do texto de descrição das cartas com os tipos de mecânica de jogo e as suas implementações. Vamos agora passar para a modelagem de tópicos, onde buscaremos segmentar as cartas de acordo com estes padrões.
Vamos começar dando um pouco mais de contexto sobre a modelagem de tópicos e de que forma o STM se encaixa dentro deste arcabouço. A partir daí vamos avançar para a preparação dos dados para o modelo, a busca pela quantidade de tópicos que devemos utilizar e, finalmente, ajustaremos o modelo selecionado.
Explica LDA.
knitr::include_graphics(path = 'images/lda_rationale.png')
Explica STM.
knitr::include_graphics(path = 'images/stm_rationale.png')
Lista de stopwords personalizada.
my_stopwords <- c('a', 'ao', 'aos', 'ate', 'cada', 'com', 'as', 'como', 'da', 'das',
'de', 'dela', 'delas', 'dele', 'desta', 'deste', 'destas', 'destes',
'deles', 'do', 'dos', 'disso', 'e', 'es', 'em', 'esta', 'ela', 'ele',
'elas', 'eles', 'for', 'foi', 'la', 'lhe', 'mais', 'nas', 'nesta',
'na', 'nas', 'nela', 'nele', 'no', 'nos', 'o', 'os', 'ou', 'para',
'por', 'pelo', 'que', 'sao', 'se', 'so', 'sos', 'sem', 'seu', 'seus',
'sua', 'suas', 's', 'si', 'todas', 'todos', 'tem', 'um', 'uma', 'voce',
'vez', 'longa', 'distancia', 'corpo', 'duas', 'dois', 'metade', 'reinos',
'norte', "scoia'tael", 'skellige', 'nilfgaard', 'sindicato', 'neutra',
'concede', 'tiver', 'seguida', 'seja', 'caso', 'faz', 'usa', 'usar',
'usando', 'usada', 'usado', 'tambem', 'houver', 'ha', 'pela', 'mesma',
'tiver', 'nao', 'nessa', 'nessas', 'nesse', 'nesses', 'qualquer',
'estiver', 'entre', 'unidade', 'unidades', 'mobilizacao', 'sempre',
'mesmo', 'perto', 'apos', 'quando', 'neste', 'nestes', "scoia'tel",
'enquanto')
Preparando os dados.
txt <- 'Esta habilidade adiciona [0-9]{2} (?:(?:de )?recrutamento[s]? ao limite )?de recrutamento (ao limite )?do (?:seu )?baralho.'
# contando ocorrencias de cada token por faccao
df_tokens <- cartas %>%
# removendo texto comum a todas as cartas de habilidade do lider
mutate(
texto = str_remove(string = texto, pattern = txt)
) %>%
# quebrando o string em tokens
unnest_tokens(output = token, input = texto) %>%
# removendo acentuacao
mutate(token = stri_trans_general(str = token, id = 'Latin-ASCII')) %>%
# removendo stopwords
filter(!token %in% my_stopwords) %>%
# removendo os digitos
filter(str_detect(string = token, pattern = '[0-9]', negate = TRUE)) %>%
# substituindo algumas formas
mutate(
token = str_replace(string = token, pattern = '(?<=o|a)s$', replacement = ''),
token = str_replace(string = token, pattern = '(?<=d|t)es$', replacement = 'e'),
token = str_replace(string = token, pattern = '(?<=r)es$', replacement = ''),
token = str_replace(string = token, pattern = 'veneno|envenenamento|envenenad[ao]', replacement = 'envenena'),
token = str_replace(string = token, pattern = 'bloqueada|bloquei[ao]', replacement = 'bloqueio'),
token = str_replace(string = token, pattern = 'reforcad[ao]', replacement = 'reforcada'),
token = str_replace(string = token, pattern = 'anoes', replacement = 'anao'),
token = str_replace(string = token, pattern = 'aleatoriamente', replacement = 'aleatorio'),
token = str_replace(string = token, pattern = 'aleatoria', replacement = 'aleatorio'),
) %>%
# contando ocorrencia dos lemmas por carta
count(localizedName, token, name = 'ocorrencias')
df_tokens
# A tibble: 7,425 × 3
localizedName token ocorrencias
<chr> <chr> <int>
1 A Fera batalha 1
2 A Fera campo 1
3 A Fera fim 1
4 A Fera maior 1
5 A Fera poder 1
6 A Fera reforca 1
7 A Fera turno 1
8 A prática leva à perfeição aleatorio 1
9 A prática leva à perfeição aliado 1
10 A prática leva à perfeição aumenta 1
# … with 7,415 more rows
Lematizando os tokens e contando-os.
# carregando mais pacotes
library(spacyr) # para ajudar com lematizacao
# inicializando o spacy
spacy_initialize(model = 'pt_core_news_lg')
# criando uma base de-para para lemmatizar os tokens
de_para_lemma <- distinct(df_tokens, token) %>%
# colocando os tokens em um vetor
pull(token) %>%
# parseando os tokens para o spacyr
spacy_parse(pos = FALSE, tag = FALSE, lemma = TRUE, dependency = FALSE) %>%
# passando o resultado para um tibble
tibble %>%
# pegando apenas as colunas que interessam
select(token, lemma)
# lemmatizando os tokens e contando ocorrencias
df_tokens <- df_tokens %>%
# juntando o de-para de lemmas aos tokens
left_join(y = de_para_lemma, by = 'token') %>%
# contando ocorrencia dos lemmas por carta
count(localizedName, lemma, name = 'ocorrencias')
df_tokens
Criando matriz DFM.
# criando matriz no formato document-feature matrix
df_esparsa <- df_tokens %>%
cast_sparse(row = localizedName, column = token, value = ocorrencias)
Procurando o valor de K.
# carregando mais pacotes
library(stm) # para a modelagem de topicos
library(furrr) # para paralelizar a busca
# setando a seed
set.seed(33)
# setando o processamento paralelo
plan(multisession)
# buscando melhor valor de K
search_K <- tibble(
K = seq(from = 6, to = 30, by = 3)
) %>%
mutate(
# rodando o STM sem nenhuma feature
padrao = future_map(.x = K,
.f = ~ stm(documents = df_esparsa, init.type = 'Spectral',
seed = 333, K = .x, verbose = FALSE),
.options = furrr_options(seed = TRUE)
),
# passando a faccao para o content
features = future_map(.x = K,
.f = ~ stm(documents = df_esparsa, init.type = 'Spectral',
seed = 333, K = .x, content = ~ slug, data = cartas,
verbose = FALSE),
.options = furrr_options(seed = TRUE)
)
) %>%
pivot_longer(cols = c(padrao, features), names_to = 'tipo', values_to = 'modelos')
# setando o processamento sequencial
plan(sequential)
Extraindo métricas de avaliação.
# extraindo as metricas de avaliacao da clusterizacao
metricas <- search_K %>%
# calculando a exclusividade e a coerencia dos topicos
mutate(
exclusividade = map(.x = modelos, .f = safely(exclusivity)),
exclusividade = map(.x = exclusividade, .f = 'result'),
coerencia = map(.x = modelos, .f = semanticCoherence, documents = df_esparsa),
residuos = map(.x = modelos, .f = checkResiduals, df_esparsa),
residuos = map(.x = residuos, 'dispersion')
) %>%
# dropando a coluna com os modelos
select(-modelos) %>%
# desaninhando as colunas de coerencia e exclusividade
unnest(cols = c(exclusividade, coerencia, residuos))
# plotando as metricas individualmente
fig_painel_metricas <- metricas %>%
# passando a base para o formato longo
pivot_longer(cols = c(exclusividade, coerencia, residuos),
names_to = 'metrica', values_to = 'valor') %>%
# dropando valores nulos
drop_na() %>%
# agrupando pelo valor de K e da metrica
group_by(K, metrica, tipo) %>%
# calculando o valor da media da metrica por valor de K
summarise(
valor = mean(x = valor, na.rm = TRUE), .groups = 'drop'
) %>%
# renomeando as metricas
mutate(
metrica = case_when(metrica == 'coerencia' ~ 'Coerência Semântica',
TRUE ~ str_to_title(string = metrica))
) %>%
# criando a figura
ggplot(mapping = aes(x = as.factor(K), y = valor, group = tipo, color = tipo)) +
facet_wrap(~ metrica, scales = 'free') +
geom_line(size = 1, show.legend = FALSE) +
geom_point(fill = 'white', color = 'black', shape = 21, size = 3, show.legend = FALSE) +
labs(
caption = 'A linha azul representa o modelo que não contempla que a ocorrência das palavras pode variar dentro dos tópicos em função da identidade da facção.',
x = 'Quantidade de tópicos (K)',
y = 'Valor da métrica'
)
# plotando as metricas de coerencia vs exclusividade
fig_coerencia_exclusividade <- metricas %>%
# filtrando os resultado do modelo sem content
filter(tipo == 'padrao') %>%
# adicionando a sequencia do numero de topicos
mutate(
K = ifelse(test = K < 10, yes = paste0('0', K), no = K),
K = paste(K, 'tópicos')
) %>%
# criando a figura
ggplot(mapping = aes(x = coerencia, y = exclusividade, color = K)) +
facet_wrap(~ K) +
geom_point(shape = 16, size = 3, show.legend = FALSE) +
scale_color_viridis_d(direction = -1, begin = 0.2, end = 0.9) +
labs(
x = 'Coerência Semântica',
y = 'Exclusividade'
)
# criando o painel
(fig_painel_metricas / fig_coerencia_exclusividade) +
plot_layout(heights = c(1, 2)) +
plot_annotation(
title = 'Quantos tópicos devemos usar?',
subtitle = 'A quantidade de tópicos escolhida deve atender ao melhor balanço entre uma alta coerência semântica e exclusividade',
tag_levels = 'A', tag_prefix = '(', tag_suffix = ')') &
theme(plot.tag = element_text(size = 10, face = 'bold'))
Ajustando o modelo de tópicos
Visualizando os topicos encontrados.
# criando figura das palavras por topicos
tidy(x = modelo, matrix = 'beta') %>%
# agrupando pelo topico
group_by(topic) %>%
# pegando as 10 palavras com maior afinade com cada tópico
slice_max(order_by = beta, n = 10, with_ties = FALSE) %>%
# criando escala numerica para colorir dentro dos topicos
mutate(escala = beta / max(beta)) %>%
# desagrupando os dados
ungroup %>%
# organizando as informacoes para plotar
mutate(
topic = ifelse(test = topic < 10,
yes = paste0('Tópico 0', topic), no = paste0('Tópico', topic)),
term = reorder_within(x = term, by = beta, within = topic)
) %>%
# criando a figura
ggplot(mapping = aes(x = beta, y = term, fill = escala)) +
facet_wrap(~ topic, scales = 'free', ncol = 4) +
geom_col(color = 'black', size = 0.3, show.legend = FALSE) +
scale_y_reordered() +
scale_fill_viridis_c(begin = 0.2, end = 0.9) +
labs(
title = 'Quais as palavras mais prováveis de serem observadas em cada tópico?',
x = expression(bold(paste('Probabilidade de ocorrência, ', beta)))
) +
theme(axis.title.y = element_blank())
Visualizando os topicos encontrados - parte 2.
# extraindo os dados dos betas por topico
df_betas <- modelo$beta %>%
# pegando a matriz com o log das probabilidades para o beta
pluck('logbeta') %>%
# parseando as matrizes para um dataframe
map(.f = data.frame) %>%
# passando o log da probabilidade para probabilidade
map(.f = exp) %>%
# colocando o nome nas colunas
map(.f = ~ `colnames<-`(x = ., value = df_esparsa@Dimnames[[2]])) %>%
# adicionando o identificador do topico a cada linha
map(.f = mutate, topic = 1:n()) %>%
# renomeando os elementos da lista
`names<-`(value = c('Monsters', 'Neutral', 'Nilfgaard', 'Northern Realms',
"Scoia'tael", 'Skellige', 'Syndicate')) %>%
# juntando todos
map_dfr(tibble, .id = 'slug') %>%
# passando a base para o formato longo
pivot_longer(cols = -c(slug, topic), names_to = 'term', values_to = 'beta')
# criando figura das palavras por topicos
df_betas %>%
# agrupando pelo topico e token
group_by(topic, term) %>%
# calculando a media da probabilidade para aquele token naquele topico
summarise(beta = mean(x = beta, na.rm = TRUE), .groups = 'drop') %>%
# agrupando pelo topico
group_by(topic) %>%
# pegando as 10 palavras com maior afinade com cada tópico
slice_max(order_by = beta, n = 10, with_ties = FALSE) %>%
# criando escala numerica para colorir dentro dos topicos
mutate(escala = beta / max(beta)) %>%
# desagrupando os dados
ungroup %>%
# organizando as informacoes para plotar
mutate(
topic = ifelse(test = topic < 10,
yes = paste0('Tópico 0', topic), no = paste0('Tópico', topic)),
term = reorder_within(x = term, by = beta, within = topic)
) %>%
# criando a figura
ggplot(mapping = aes(x = beta, y = term, fill = escala)) +
facet_wrap(~ topic, scales = 'free', ncol = 4) +
geom_col(color = 'black', size = 0.3, show.legend = FALSE) +
scale_y_reordered() +
scale_fill_viridis_c(begin = 0.2, end = 0.9) +
labs(
title = 'Quais as palavras mais prováveis de serem observadas em cada tópico?',
x = expression(bold(paste('Probabilidade de ocorrência, ', beta)))
) +
theme(axis.title.y = element_blank())
Visualizando a proporcao de topicos.
# criando tabela com as 5 palavras mais frequentes por topico para plotarmos abaixo
df_top_palavras <- tidy(x = modelo, matrix = 'beta') %>%
# agrupando pelo topico
group_by(topic) %>%
# pegando as 10 palavras com maior afinade com cada tópico
slice_max(order_by = beta, n = 5, with_ties = FALSE) %>%
# colocando essas palavras em um vetor
summarise(palavras = paste0(term, collapse = ', '))
# se usarmos o content quando rodar o STM, é necessário descomentar as linhas abaixo
# df_top_palavras <- df_betas %>%
# # agrupando pelo topico e token
# group_by(topic, term) %>%
# # calculando a media da probabilidade para aquele token naquele topico
# summarise(beta = mean(x = beta, na.rm = TRUE), .groups = 'drop') %>%
# # agrupando pelo topico
# group_by(topic) %>%
# # pegando as 10 palavras com maior afinade com cada tópico
# slice_max(order_by = beta, n = 5, with_ties = FALSE) %>%
# # colocando essas palavras em um vetor
# summarise(palavras = paste0(term, collapse = ', '))
# criando a figura de prevalencia por topico
tidy(x = modelo, matrix = 'gamma') %>%
# agrupando pelo topico
group_by(topic) %>%
# extraindo a media da probabilidade para cada topico
# esse é o valor esperado da prevalencia do tópico
summarise(
media = mean(x = gamma), .groups = 'drop'
) %>%
# juntando as 5 palavras mais frequentes por topico
left_join(y = df_top_palavras, by = 'topic') %>%
# reordenando as colunas
mutate(
topic = ifelse(test = topic < 10, yes = paste0('0', topic), no = topic),
topic = paste('Tópico', topic),
topic = fct_reorder(.f = topic, .x = media)
) %>%
# criando a figura
ggplot(mapping = aes(x = media, y = topic, fill = media)) +
geom_col(color = 'black', size = 0.3, show.legend = FALSE) +
geom_text(mapping = aes(label = round(x = media, digits = 3), color = media <= 0.04),
nudge_x = -0.01, fontface = 'bold', show.legend = FALSE) +
geom_text(mapping = aes(label = palavras), nudge_x = 0.005, hjust = 0) +
scale_x_continuous(breaks = seq(from = 0, to = 0.25, by = 0.05),
limits = c(0, 0.27)) +
scale_fill_viridis_c(begin = 0.2, end = 0.9) +
scale_color_manual(values = c('black', 'white')) +
labs(
title = 'Quais os tópicos mais prevalentes entre as cartas?',
x = expression(bold(paste('Probabilidade de ocorrência, ', gamma)))
) +
theme(axis.title.y = element_blank())
Visualiza correlação entre topicos.
# carregando pacotes
library(corrr) # para o plot abaixo
# criando uma plot de correlacao entre os topicos
topicCorr(model = modelo) %>%
# pegando a matriz de correlacao
pluck('cor') %>%
# colocando o nome das dimensoes
`rownames<-`(value = paste0('Tópico ', 1:18)) %>%
`colnames<-`(value = paste0('Tópico ', 1:18)) %>%
# passando para uma matriz do corrr
as_cordf() %>%
# passando a matriz de correlacao para o formato longo
stretch(na.rm = TRUE, remove.dups = TRUE) %>%
# adicionando contagem de ocorrencias de x e y para ordenar as linhas
# e colunas da figura
add_count(x, name = 'n_x') %>%
add_count(y, name = 'n_y') %>%
mutate(
y = fct_reorder(.f = y, .x = n_y, .desc = TRUE),
x = fct_reorder(.f = x, .x = n_x, .desc = TRUE)
) %>%
# criando a figura
ggplot(mapping = aes(x = x, y = y, fill = r)) +
geom_tile(color = 'black') +
geom_text(mapping = aes(label = round(x = r, digits = 2), color = abs(x = r) > 0.3),
fontface = 'bold', show.legend = FALSE) +
scale_fill_gradient2(low = 'midnightblue', mid = 'white', high = 'firebrick', midpoint = 0) +
scale_color_manual(values = c('NA', 'black')) +
labs(
title = 'Qual a relação entre os tópicos identificados?',
subtitle = 'São poucos os tópicos que compartilham algum tipo de relação'
) +
theme(
axis.title = element_blank(),
panel.grid = element_blank(),
axis.text.x = element_text(angle = 30, hjust = 1)
)
Estimando a relacao entre topicos e metadados.
# estimando a contribuicao das features para explicar os clusters
explica_topicos <- estimateEffect(1:18 ~ 0 + slug, stmobj = modelo,
metadata = cartas, uncertainty = 'Global')
# pegando os slopes das regressoes
tidy(x = explica_topicos) %>%
# ajustando os dados para plotar
mutate(
# ajustando o nome das faccoes
term = str_remove(string = term, pattern = 'slug'),
term = str_replace_all(string = term, pattern = '\\(Intercept\\)', replacement = 'Monsters'),
# criando codificacao de cor a partir do nome original da faccao
cores = term,
# ajustando o nome dos topicos
topic = ifelse(test = topic < 10, yes = paste0('Tópico 0', topic), no = paste0('Tópico ', topic)),
# ordenando as faccoes dentro dos topicos atraves da estimativa do slope
term = reorder_within(x = term, by = estimate, within = topic)
) %>%
# criando a figura
ggplot(mapping = aes(x = estimate, y = term, fill = cores, group = 1)) +
facet_wrap(~ topic, scales = 'free', ncol = 4) +
geom_col(color = 'black', size = 0.3, show.legend = FALSE) +
scale_y_reordered() +
scale_fill_manual(values = cores_por_faccao) +
labs(
title = 'Quais as facções mais relacionadas com cada tópico?',
x = 'Coeficientes da regressão'
) +
theme(axis.title.y = element_blank())
Juntando probabilidades às cartas.
# pegando a matriz gamma - as probabilidade de cada topico por documento
embeddings <- tidy(x = modelo, matrix = 'gamma') %>%
# juntando o prefixo topic_ ao numero de cada topico
mutate(topic = paste0('topic_', topic)) %>%
# pivoteando a tabela para o formato largo
pivot_wider(id_cols = document, names_from = topic, values_from = gamma) %>%
# agrupando o dataframe por linha
rowwise() %>%
# extraindo o topico mais provavel por linha
mutate(
topK = which.max(c_across(contains('topic_'))),
topK = ifelse(test = topK < 10, yes = paste0('Tópico 0', topK), no = paste0('Tópico ', topK))
) %>%
# desagrupando o dataframe
ungroup %>%
# colocando o nome das cartas na coluna do nome do documento
mutate(document = cartas$localizedName) %>%
# juntando os metadados das cartas
left_join(y = cartas, by = c('document' = 'localizedName'))
embeddings
# A tibble: 1,103 × 38
document topic_1 topic_2 topic_3 topic_4 topic_5 topic_6 topic_7
<chr> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
1 A Fera 0.0316 0.0332 0.0424 0.0106 0.0268 0.0849 0.00470
2 A prática … 0.0167 0.0287 0.0481 0.0557 0.0341 0.0468 0.00585
3 A Terra da… 0.0189 0.0473 0.217 0.0431 0.0249 0.0171 0.0122
4 A Trufa Ca… 0.0122 0.0621 0.0513 0.0582 0.0525 0.0129 0.0105
5 Abaya 0.0104 0.0338 0.0116 0.0229 0.00804 0.00995 0.00962
6 Aberrações… 0.0211 0.0329 0.0166 0.00459 0.0219 0.0361 0.00431
7 Abominação… 0.0997 0.0287 0.0440 0.00978 0.0335 0.0575 0.00421
8 Acônito 0.0346 0.0199 0.0221 0.00995 0.00459 0.312 0.00299
9 Açougueiro… 0.0267 0.0530 0.0191 0.00652 0.0146 0.0826 0.00914
10 Adaga Ceri… 0.0324 0.0815 0.0233 0.00861 0.0123 0.106 0.0129
# … with 1,093 more rows, and 30 more variables: topic_8 <dbl>,
# topic_9 <dbl>, topic_10 <dbl>, topic_11 <dbl>, topic_12 <dbl>,
# topic_13 <dbl>, topic_14 <dbl>, topic_15 <dbl>, topic_16 <dbl>,
# topic_17 <dbl>, topic_18 <dbl>, topK <chr>, name <chr>,
# short <chr>, slug <chr>, rarity <chr>, cardGroup <chr>,
# type <chr>, categoryName <chr>, ownable <lgl>, decks <int>,
# craftingCost <int>, power <int>, provisionsCost <int>, …
Ajustando TSNE.
# carregando o pacote
library(Rtsne) # para rodar o TSNE
library(plotly) # para visualizar o TSNE
# setando a seed
set.seed(33)
# ajustando o TSNE
tsne_results <- select(embeddings, contains('topic_')) %>%
# passando objeto para matrix
as.matrix() %>%
# ajustando tSNE
Rtsne(check_duplicates = FALSE, perplexity = 20)
# plotando resultados do TSNE
tsne_results %>%
# pegando os resultado do TSNE
pluck('Y') %>%
# passando para um dataframe
data.frame %>%
# renomeando as colunas
`names<-`(value = c('tsne1', 'tsne2')) %>%
# passando para um tibble
tibble %>%
# juntando com o nome das cartas
bind_cols(embeddings) %>%
# criando a figura
plot_ly(x = ~ tsne1, y = ~ tsne2, color = ~ slug, data = ., colors = cores_por_faccao,
mode = 'markers', type = 'scatter', marker = list(size = 7, opacity = 0.7),
hoverinfo = 'text',
hovertext = ~ paste0(
'<b>Tópico prevalente:</b> ', topK, '<br>',
'<b>Carta:</b> ', document, '<br>',
'<b>Raridade:</b> ', rarity, '<br>',
'<b>Tipo:</b> ', type, '<br>',
str_wrap(string = texto, width = 50)
)
) %>%
layout(xaxis = list(title = 'Dimensão 1'), yaxis = list(title = 'Dimensão 2'))
Nearest neighbors.
# carregando funcoes
library(widyr) # para trabalhar em formato largo
# colocando os embeddings no formato para a funcao abaixo
df_embedding <- select(embeddings, document, contains('topic_')) %>%
# passando a base para o formato longo
pivot_longer(cols = contains('topic_'), names_to = 'topico', values_to = 'probabilidade')
# criando funcao para calcular o nearest neighbors
nearest_neighbors <- function(df, carta, vizinhos) {
# pegando a faccao da carta selecionada
faccao_selecionada <- cartas %>%
# filtrando a carta selecionada
filter(localizedName == carta) %>%
# pegando a faccao da carta
pull(slug)
# filtrando as cartas que serao comparadas
if(faccao_selecionada != 'Neutral') {
cartas_usaveis <- cartas %>%
# filtrando todas as cartas da faccao da carta selecionada
filter(slug %in% faccao_selecionada) %>%
# pegando o nome das cartas
pull(localizedName)
# pegando todas as cartas caso a facção da carta alvo seja a neutra
} else {
cartas_usaveis <- pull(cartas, localizedName)
}
# calculando a similaridade de coseno entre todas as cartas e a carta alvo
df %>%
# filtrando apenas as cartas que serao comparadas
filter(document %in% cartas_usaveis) %>%
# aplicando a funcao
widely(
~ {
# cria matriz n x m, onde n eh o numero de cartas que existem na base de dados, e m
# é o número de tópicos identificados através do STM - o conteúdo de cada célular na
# matriz é a probabilidade de que àquela carta esteja associada aquele tópico
y <- .[rep(carta, nrow(.)), ]
# no codigo abaixo o '.' representa a matriz de probablidades de cada carta possuir
# cada tópico, e é uma matriz n x m onde o n é cada uma das cartas e o m corresponde
# a várias colunas que representam cada um dos tópicos. Calcularemos então a similaridade
# do conseno a carta selecionado e o embedding representado por cada outra carta:
# - rowSums(. * y): multiplica a matriz do embedding de todos as cartas pela matriz
# da carta selecionada
# - sqrt(rowSums(. ^ 2)): retorna um vetor numerico, com um elemento por carta o valor
# associado à cada carta representa o somatorio dos valores entre todas as dimensoes
# de seu embedding (i.e., todos os topicos associado àquela carta)
# sqrt(sum(.[token, ] ^ 2)): retorna um valor numérico, que representa o somatório dos
# valores entre todas as dimensoes do embedding para a carta selecionada
# (sqrt(rowSums(. ^ 2)) * sqrt(sum(.[token, ] ^ 2))): multiplica o valor do embedding
# de cada carta pelo da carta selecionado, padronizando a similaridade calculada
# pelo 'rowSums(. * y)'
similaridade_coseno <- rowSums(. * y) / (sqrt(rowSums(. ^ 2)) * sqrt(sum(.[carta, ] ^ 2)))
# coloca o resultado em uma matriz com o nome de linha vinda do nome das cartas
#matrix(similaridade_coseno, ncol = 1, dimnames = list(x = names(similaridade_coseno)))
},
sort = TRUE
)(document, topico, probabilidade) %>%
# organizando as cartas em ordem decrescente de similaridade
arrange(desc(item2)) %>%
# pegando apenas a quantidade desejada de cartas similares
slice_max(order_by = item2, n = vizinhos) %>%
# juntando com metadados das cartas resultantes
left_join(y = select(cartas, localizedName, slug, small, texto), by = c('item1' = 'localizedName'))
}
Exemplo Scoia’tael.
df_embedding %>%
# calculando o nearest neighbors
nearest_neighbors(carta = 'Bruxo Gato', vizinhos = 5) %>%
# selecionando as colunas que vamos plotar
select(small, item1, item2, texto) %>%
# adicionando o prefixo do link para a imagem
mutate(small = paste0('https://www.playgwent.com/', small)) %>%
# colocando os exemplos em um reactable
reactable(
compact = TRUE, borderless = TRUE, defaultColDef = colDef(align = 'left'),
style = list(fontFamily = "Roboto", fontSize = "12px"),
columns = list(
small = colDef(name = '', cell = embed_img(height = 80, width = 60), maxWidth = 80),
item1 = colDef(name = 'Carta', maxWidth = 90),
item2 = colDef(name = 'Similaridade', maxWidth = 90, format = colFormat(digits = 3)),
texto = colDef(name = 'Descrição')
)
)
Exemplo Northern Realms.
df_embedding %>%
# calculando o nearest neighbors
nearest_neighbors(carta = 'Imortais', vizinhos = 5) %>%
# selecionando as colunas que vamos plotar
select(small, item1, item2, texto) %>%
# adicionando o prefixo do link para a imagem
mutate(small = paste0('https://www.playgwent.com/', small)) %>%
# colocando os exemplos em um reactable
reactable(
compact = TRUE, borderless = TRUE, defaultColDef = colDef(align = 'left'),
style = list(fontFamily = "Roboto", fontSize = "12px"),
columns = list(
small = colDef(name = '', cell = embed_img(height = 80, width = 60), maxWidth = 80),
item1 = colDef(name = 'Carta', maxWidth = 140),
item2 = colDef(name = 'Similaridade', maxWidth = 90, format = colFormat(digits = 3)),
texto = colDef(name = 'Descrição')
)
)
Exemplo Nilfgaard.
df_embedding %>%
# calculando o nearest neighbors
nearest_neighbors(carta = 'Artorius Viggo', vizinhos = 5) %>%
# selecionando as colunas que vamos plotar
select(small, item1, item2, texto) %>%
# adicionando o prefixo do link para a imagem
mutate(small = paste0('https://www.playgwent.com/', small)) %>%
# colocando os exemplos em um reactable
reactable(
compact = TRUE, borderless = TRUE, defaultColDef = colDef(align = 'left'),
style = list(fontFamily = "Roboto", fontSize = "12px"),
columns = list(
small = colDef(name = '', cell = embed_img(height = 80, width = 60), maxWidth = 80),
item1 = colDef(name = 'Carta', maxWidth = 140),
item2 = colDef(name = 'Similaridade', maxWidth = 90, format = colFormat(digits = 3)),
texto = colDef(name = 'Descrição')
)
)
Exemplo Neutral.
df_embedding %>%
# calculando o nearest neighbors
nearest_neighbors(carta = 'Alzur', vizinhos = 5) %>%
# selecionando as colunas que vamos plotar
select(small, item1, slug, item2, texto) %>%
# adicionando o prefixo do link para a imagem
mutate(small = paste0('https://www.playgwent.com/', small)) %>%
# colocando os exemplos em um reactable
reactable(
compact = TRUE, borderless = TRUE, defaultColDef = colDef(align = 'left'),
style = list(fontFamily = "Roboto", fontSize = "12px"),
columns = list(
small = colDef(name = '', cell = embed_img(height = 80, width = 60), maxWidth = 80),
item1 = colDef(name = 'Carta', maxWidth = 140),
slug = colDef(name = 'Facção', maxWidth = 90),
item2 = colDef(name = 'Similaridade', maxWidth = 90, format = colFormat(digits = 3)),
texto = colDef(name = 'Descrição')
)
)
Dúvidas, sugestões ou críticas? É só me procurar pelo e-mail ou GitHub!